home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1990 / 04 / dunteman.lst < prev    next >
File List  |  1990-03-09  |  11KB  |  340 lines
  1. STRUCTURED PROGRAMMING COLUMN
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6.  
  7. {---------------------------------------------------}
  8. {                     TIMEDATE                      }
  9. {                                                   }
  10. { A Time-and-date stamp object for Turbo Pascal 5.5 }
  11. {                                                   }
  12. {                           by Jeff Duntemann       }
  13. {                           Last update 12/23/89    }
  14. {                                                   }
  15. { NOTE: This unit should be good until December 31, }
  16. { 2043, when the long integer time/date stamp turns }
  17. { negative.  HOWEVER, the Zeller's Congruence       }
  18. { algorithm shown here fails at the end of the 20th }
  19. { century.  I should be able to figure out the fix  }
  20. { by then...                                        }
  21. {---------------------------------------------------}
  22.  
  23. UNIT TimeDate;
  24.  
  25. INTERFACE
  26.  
  27. USES DOS;
  28.  
  29. TYPE
  30.   String9  = STRING[9];
  31.   String20 = STRING[20];
  32.   String50 = STRING[50];
  33.  
  34.   When =
  35.     OBJECT
  36.       WhenStamp      : LongInt;      { Combined time/date stamp }
  37.       TimeString     : String9;      { i.e., "12:45a"           }
  38.       Hours,Minutes,Seconds : Word;  { Seconds is always even!  }
  39.       DateString     : String20;     { i.e., "06/29/89"         }
  40.       LongDateString : String50;     { i.e., "Thursday, June 29, 1989" }
  41.       Year,Month,Day : Word;
  42.       DayOfWeek      : Integer;      { 0=Sunday, 1=Monday, etc. }
  43.       FUNCTION GetTimeStamp : Word;  { Returns DOS-format time stamp }
  44.       FUNCTION GetDateStamp : Word;  { Returns DOS-format date dtamp }
  45.       PROCEDURE PutNow;
  46.       PROCEDURE PutWhenStamp(NewWhen  : LongInt);
  47.       PROCEDURE PutTimeStamp(NewStamp : Word);
  48.       PROCEDURE PutDateStamp(NewStamp : Word);
  49.       PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : Word);
  50.       PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
  51.     END;
  52.  
  53.  
  54. IMPLEMENTATION
  55.  
  56. { Keep in mind that all this stuff is PRIVATE to the unit! }
  57.  
  58. CONST
  59.   MonthTags : ARRAY [1..12] of String9 =
  60.     ('January','February','March','April','May','June','July',
  61.      'August','September','October','November','December');
  62.   DayTags   : ARRAY [0..6] OF String9 =
  63.     ('Sunday','Monday','Tuesday','Wednesday',
  64.      'Thursday','Friday','Saturday');
  65.  
  66. TYPE
  67.   WhenUnion =
  68.     RECORD
  69.       TimePart : Word;
  70.       DatePart : Word;
  71.     END;
  72.  
  73. VAR
  74.   Temp1 : String50;
  75.   Dummy : Word;
  76.  
  77. { Some utility routines private to this unit: }
  78.  
  79. FUNCTION CalcTimeStamp(Hours,Minutes,Seconds : Word) : Word;
  80.  
  81. BEGIN
  82.   CalcTimeStamp := (Hours SHL 11) OR (Minutes SHL 5) OR (Seconds SHR 1);
  83. END;
  84.  
  85.  
  86. FUNCTION CalcDateStamp(Year,Month,Day : Word) : Word;
  87.  
  88. BEGIN
  89.   CalcDateStamp := ((Year - 1980) SHL 9) OR (Month SHL 5) OR Day;
  90. END;
  91.  
  92.  
  93. PROCEDURE CalcTimeString(VAR TimeString : String9;
  94.                          Hours,Minutes,Seconds : Word);
  95.  
  96. VAR
  97.   Temp1,Temp2 : String9;
  98.   AMPM        : Char;
  99.   I           : Integer;
  100.  
  101. BEGIN
  102.   I := Hours;
  103.   IF Hours = 0 THEN I := 12;   { "0" hours = 12am }
  104.   IF Hours > 12 THEN I := Hours - 12;
  105.   IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a';
  106.   Str(I:2,Temp1); Str(Minutes,Temp2);
  107.   IF Length(Temp2) < 2 THEN Temp2 := '0' + Temp2;
  108.   TimeString := Temp1 + ':' + Temp2 + AMPM;
  109. END;
  110.  
  111.  
  112. PROCEDURE CalcDateString(VAR DateString : String20;
  113.                          Year,Month,Day : Word);
  114. BEGIN
  115.   Str(Month,DateString);
  116.   Str(Day,Temp1);
  117.   DateString := DateString + '/' + Temp1;
  118.   Str(Year,Temp1);
  119.   DateString := DateString + '/' + Copy(Temp1,3,2);
  120. END;
  121.  
  122.  
  123. PROCEDURE CalcLongDateString(VAR LongdateString : String50;
  124.                              Year,Month,Date,DayOfWeek : Word);
  125. VAR
  126.   Temp1 : String9;
  127.  
  128. BEGIN
  129.   LongDateString := DayTags[DayOfWeek] + ', ';
  130.   Str(Date,Temp1);
  131.   LongDateString := LongDateString +
  132.     MonthTags[Month] + ' ' + Temp1 + ', ';
  133.   Str(Year,Temp1);
  134.   LongDateString := LongDateString + Temp1;
  135. END;
  136.  
  137.  
  138. {---------------------------------------------------------------------}
  139. { This calculates a day of the week figure, where 0=Sunday, 1=Monday, }
  140. { and so on, given the year, month, and day.  The year may be passed  }
  141. { as either "1989" or "89" but *not* as 1980-relative, or "9".  Also  }
  142. { note that this particular algorithm turns into a pumpkin in 2000.   }
  143. { BTW, don't ask me to explain how this crazy thing works.  I haven't }
  144. { the foggiest notion.  If I ever meet Mr. Zeller, I'll ask him.      }
  145. {---------------------------------------------------------------------}
  146.  
  147. FUNCTION CalcDayOfWeek(Year,Month,Day : Word) : Integer;
  148.  
  149. VAR
  150.   Century,Leftovers,Holder : Integer;
  151.  
  152. BEGIN
  153.   { First test for error conditions on input values: }
  154.   IF (Year < 0)  OR
  155.      (Month < 1) OR (Month > 12) OR
  156.      (Day < 1)   OR (Day > 31) THEN
  157.      CalcDayOfWeek := -1  { Return -1 to indicate an error }
  158.   ELSE
  159.     { Do the Zeller's Congruence calculation: }
  160.     BEGIN
  161.       IF Year < 100 THEN Inc(Year,1900);
  162.       Dec(Month,2);
  163.       IF (Month < 1) OR (Month > 10) THEN
  164.         BEGIN
  165.           Dec(Year,1);
  166.          Inc(Month,12);
  167.         END;
  168.       Century   := Year DIV 100;
  169.       Leftovers := Year MOD 100;
  170.       Holder    := (Trunc(Int(2.6 * Month - 0.2)) + Day +
  171.                     Leftovers + (Leftovers DIV 4) +
  172.                     (Century DIV 4) - Century - Century) MOD 7;
  173.       IF Holder < 0 THEN
  174.         Inc(Holder,7);
  175.       CalcDayOfWeek := Holder;
  176.     END;
  177. END;
  178.  
  179.  
  180. {***************************************}
  181. { Method implementations for type When: }
  182. {***************************************}
  183.  
  184.  
  185. {---------------------------------------------------------------------}
  186. { There will be many times when an individual date or time stamp will }
  187. { be much more useful than a combined time/date stamp.  These simple  }
  188. { functions return the appropriate half of the combined long integer  }
  189. { time/date stamp without incurring any calculation overhead.  It's   }
  190. { done with a simple value typecast:                                  }
  191. {---------------------------------------------------------------------}
  192.  
  193. FUNCTION When.GetTimeStamp : Word;
  194.  
  195. BEGIN
  196.   GetTimeStamp := WhenUnion(WhenStamp).TimePart;
  197. END;
  198.  
  199.  
  200. FUNCTION When.GetDateStamp : Word;
  201.  
  202. BEGIN
  203.   GetDateStamp := WhenUnion(WhenStamp).DatePart;
  204. END;
  205.  
  206.  
  207. {---------------------------------------------------------------------}
  208. { To fill a When record with the current time and date as maintained  }
  209. { by the system clock, execute this method:                           }
  210. {---------------------------------------------------------------------}
  211.  
  212. PROCEDURE When.PutNow;
  213.  
  214. BEGIN
  215.   { Get current clock time.  Note that we ignore hundredths figure: }
  216.   GetTime(Hours,Minutes,Seconds,Dummy);
  217.   { Calculate a new time stamp and update object fields: }
  218.   PutTimeStamp(CalcTimeStamp(Hours,Minutes,Seconds));
  219.   GetDate(Year,Month,Day,Dummy); { Get current clock date }
  220.   { Calculate a new date stamp and update object fields: }
  221.   PutDateStamp(CalcDateStamp(Year,Month,Day));
  222. END;
  223.  
  224.  
  225. {---------------------------------------------------------------------}
  226. { This method allows us to apply a whole long integer time/date stamp }
  227. { such as that returned by the DOS unit's GetFTime procedure to the   }
  228. { When object.  The object divides the stamp into time and date       }
  229. { portions and recalculates all other fields in the object.           }
  230. {---------------------------------------------------------------------}
  231.  
  232. PROCEDURE When.PutWhenStamp(NewWhen  : LongInt);
  233.  
  234. BEGIN
  235.   WhenStamp := NewWhen;
  236.   { We've actually updated the stamp proper, but we use the two }
  237.   { "put" routines for time and date to generate the individual }
  238.   { field and string representation forms of the time and date. }
  239.   { I know that the "put" routines also update the long integer }
  240.   { stamp, but while unnecessary it does no harm.               }
  241.   PutTimeStamp(WhenUnion(WhenStamp).TimePart);
  242.   PutDateStamp(WhenUnion(WhenStamp).DatePart);
  243. END;
  244.  
  245.  
  246. {---------------------------------------------------------------------}
  247. { We can choose to update only the time stamp, and the object will    }
  248. { recalculate only its time-related fields.                           }
  249. {---------------------------------------------------------------------}
  250.  
  251. PROCEDURE When.PutTimeStamp(NewStamp : Word);
  252.  
  253. BEGIN
  254.   WhenUnion(WhenStamp).TimePart := NewStamp;
  255.   { The time stamp is actually a bitfield, and all this shifting left }
  256.   { and right is just extracting the individual fields from the stamp:}
  257.   Hours := NewStamp SHR 11;
  258.   Minutes := (NewStamp SHR 5) AND $003F;
  259.   Seconds := (NewStamp SHL 1) AND $001F;
  260.   { Derive a string version of the time: }
  261.   CalcTimeString(TimeString,Hours,Minutes,Seconds);
  262. END;
  263.  
  264.  
  265. {---------------------------------------------------------------------}
  266. { Or, we can choose to update only the date stamp, and the object     }
  267. { will then recalculate only its date-related fields.                 }
  268. {---------------------------------------------------------------------}
  269.  
  270. PROCEDURE When.PutDateStamp(NewStamp : Word);
  271.  
  272. BEGIN
  273.   WhenUnion(WhenStamp).DatePart := NewStamp;
  274.   { Again, the date stamp is a bit field and we shift the values out  }
  275.   { of it: }
  276.   Year := (NewStamp SHR 9) + 1980;
  277.   Month := (NewStamp SHR 5) AND $000F;
  278.   Day := NewStamp AND $001F;
  279.   { Calculate the day of the week value using Zeller's Congruence:    }
  280.   DayOfWeek := CalcDayOfWeek(Year,Month,Day);
  281.   { Calculate the short string version of the date; as in "06/29/89": }
  282.   CalcDateString(DateString,Year,Month,Day);
  283.   { Calculate a long version, as in "Thursday, June 29, 1989": }
  284.   CalcLongDateString(LongdateString,Year,Month,Day,DayOfWeek);
  285. END;
  286.  
  287.  
  288. PROCEDURE When.PutNewDate(NewYear,NewMonth,NewDay : Word);
  289.  
  290. BEGIN
  291.   { The "boss" field is the date stamp.  Everything else is figured }
  292.   { from the stamp, so first generate a new date stamp, and then    }
  293.   { (odd as it may seem) regenerate everything else, *including*    }
  294.   { the Year, Month, and Day fields: }
  295.   PutDateStamp(CalcDateStamp(NewYear,NewMonth,NewDay));
  296.   { Calculate the short string version of the date; as in "06/29/89": }
  297.   CalcDateString(DateString,Year,Month,Day);
  298.   { Calculate a long version, as in "Thursday, June 29, 1989": }
  299.   CalcLongDateString(LongdateString,Year,Month,Day,DayOfWeek);
  300. END;
  301.  
  302.  
  303. PROCEDURE When.PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
  304.  
  305. BEGIN
  306.   { The "boss" field is the time stamp.  Everything else is figured }
  307.   { from the stamp, so first generate a new time stamp, and then    }
  308.   { (odd as it may seem) regenerate everything else, *including*    }
  309.   { the Hours, Minutes, and Seconds fields: }
  310.   PutTimeStamp(CalcTimeStamp(NewHours,NewMinutes,NewSeconds));
  311.   { Derive the string version of the time: }
  312.   CalcTimeString(TimeString,Hours,Minutes,Seconds);
  313. END;
  314.  
  315.  
  316. END.
  317.  
  318.  
  319. [LISTING TWO]
  320.  
  321.  
  322. PROGRAM TimeTest;
  323.  
  324. USES Crt,TimeDate;
  325.  
  326. VAR
  327.   Now : When;
  328.  
  329. BEGIN
  330.   Write('At the tone, it will be exactly ');
  331.   Delay(1000);
  332.   Now.PutNow;
  333.   Sound(1000); Delay(100); NoSound;
  334.   WITH Now DO Writeln(TimeString,'m on ',LongDateString,'.');
  335.   Readln
  336. END.
  337.  
  338.  
  339.  
  340.